home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / Pascal / Snippets / PNL Libraries / Libraries / NewFader 2.0 / GammaPaslib.p next >
Text File  |  1997-04-16  |  11KB  |  361 lines
  1. unit GammaPaslib;
  2.  
  3. {--------------------------------------------------------------------------------------------------------------- }
  4. { File "gamma.p" - Source for Altering the Gamma Tables of GDevices from Gamma.c                                 }
  5. {   Last updated 6/29/95, MJS                                                                                     }
  6. {--------------------------------------------------------------------------------------------------------------- }
  7. {    7-13-95    ported to pascal  by Matthew Xavier Mora mxmora@mxmdesigns.com                                         }
  8. {     7-18-95     fixed all the porting bugs and got it to work in think pascal                                     }
  9. {----------------------------------------------------------------------------------------------------------------}
  10. {     7-18-95 ported to CW (68k and PPC) by Bill Catambay (pretty easy), cleaned the code a bit (no more labels),     }
  11. {           brought back Matthew's delay fade routines (in main program).                                             }
  12. {----------------------------------------------------------------------------------------------------------------}
  13.  
  14.  
  15.  
  16. {---------------------------------------------------------------------------------------------------------------}
  17. {    This is the Source Code for the Gamma Utils Library file. Use this to build                                    }
  18. {        new functionality into the library or make an A4-based library.                                         }
  19. {    See the header file "gamma.h" for much more information. -- MJS                                                }
  20. {---------------------------------------------------------------------------------------------------------------}
  21. interface
  22.  
  23.     uses
  24. {$IFC UNDEFINED THINK_PASCAL}
  25.         OSUtils, Memory, Types, ToolUtils, Files, Devices, Quickdraw,
  26. {$ENDC}
  27.         Traps, Video;
  28.  
  29.     const
  30.         kGammaUtilsSig = 'GAMA';
  31.         kGetDeviceListTrapNum = $AA29;
  32.  
  33.     type
  34.         globalGammasPtr = ^globalGammas;
  35.         globalGammasHdl = ^globalGammasPtr;
  36.         globalGammas = record
  37.                 size, dataOffset: Integer;
  38.                 saved, hacked: GammaTblHandle;
  39.                 theGDevice: GDHandle;
  40.                 next: globalGammasHdl;
  41.             end;
  42.         gammaData = packed array[0..100000] of Byte;  {used to set the gamma}
  43.         gammaDataPtr = ^gammaData;
  44.  
  45.     var
  46.         gammaUtilsInstalled: OSType;
  47.         gammaTables: globalGammasHdl;
  48.  
  49.  
  50. { Function Prototypes}
  51.  
  52.     function IsGammaAvailable: Boolean;
  53.  
  54.     function IsOneGammaAvailable (theGDevice: GDHandle): Boolean;
  55.  
  56.  
  57. {    These routines help you determine whether you can use the Gamma Table Utils}
  58. {        on the current machine. The first checks all attached monitors, and the }
  59. {        second just checks the indicated monitor. Each returns TRUE if you can }
  60. {        use the functions, or FALSE if you can't. • Note: Before calling any other}
  61. {        Gamma Table function below, use this function to see if you are allowed.}
  62.  
  63. { * ****************************************************************************** *}
  64.  
  65.     function SetupGammaTools: OSErr;
  66.  
  67.     function DisposeGammaTools: OSErr;
  68.  
  69.  
  70. {    These routines must bracket any calls to the Gamma Table functions, perhaps}
  71. {        at the head and tail of your main(). The first sets up the data structures}
  72. {        necessary to save and restore the state of your monitors. The second}
  73. {        disposes of all the internal data structures, but does not reset the}
  74. {        monitors to their original states. Both return the error code if some}
  75. {        part failed. }
  76.  
  77. { * ****************************************************************************** *}
  78.  
  79.     function DoGammaFade (percent: Integer): OSErr;
  80.     function DoOneGammaFade (theGDevice: GDHandle; percent: Integer): OSErr;
  81.  
  82.  
  83. {    Use the first function to Fade each of your monitors to some percentage of their}
  84. {        initial brightness (100 = bright, 0 = dim). Repeatedly call this to ramp your}
  85. {        monitors up or down. The second function performs the same function, but only}
  86. {        for the specified monitor. Both return any applicable error codes.}
  87. {    Be sure to set up the necessary save-state data structures before you start by}
  88. {        calling the compatibility and initialization functions. }
  89.  
  90. { * ****************************************************************************** *}
  91.  
  92.     function GetDevGammaTable (theGDevice: GDHandle; var theTable: GammaTblPtr): OSErr;
  93.     function SetDevGammaTable (theGDevice: GDHandle; var theTable: GammaTblPtr): OSErr;
  94.  
  95.  
  96. {    These routines are low-level interfaces to the device drivers for the monitors.}
  97. {        Use them at your own risk.}
  98.  
  99.  
  100. implementation
  101.  
  102.     function IsGammaAvailable: Boolean;
  103.  
  104.         var
  105.             theGDevice: GDHandle;
  106.  
  107.     begin
  108.         IsGammaAvailable := false;
  109.         if (NGetTrapAddress(kGetDeviceListTrapNum, ToolTrap) = NGetTrapAddress(_Unimplemented, ToolTrap)) then
  110.             exit(IsGammaAvailable);
  111.         theGDevice := GetDeviceList;
  112.         while (theGDevice <> nil) do
  113.             begin
  114.                 if (TestDeviceAttribute(theGDevice, screenDevice) and TestDeviceAttribute(theGDevice, noDriver)) then
  115.                     exit(IsGammaAvailable);
  116.                 if (theGDevice^^.gdType = fixedType) then
  117.                     exit(IsGammaAvailable);
  118.                 theGDevice := GetNextDevice(theGDevice);
  119.             end;
  120.         IsGammaAvailable := true; {If we made it this far then its true}
  121.     end;
  122.  
  123.  
  124.     function IsOneGammaAvailable (theGDevice: GDHandle): Boolean;
  125.  
  126.     begin
  127.         IsOneGammaAvailable := false;
  128.         if (NGetTrapAddress(kGetDeviceListTrapNum, ToolTrap) = NGetTrapAddress(_Unimplemented, ToolTrap)) then
  129.             exit(IsOneGammaAvailable);
  130.         if (TestDeviceAttribute(theGDevice, screenDevice) and TestDeviceAttribute(theGDevice, noDriver)) then
  131.             exit(IsOneGammaAvailable);
  132.         if (theGDevice^^.gdType = fixedType) then
  133.             exit(IsOneGammaAvailable);
  134.         IsOneGammaAvailable := true;
  135.     end;
  136.  
  137.  
  138.     function SetupGammaTools: OSErr;
  139.  
  140.         var
  141.             errorCold: Integer;
  142.             tempHdl: globalGammasHdl;
  143.             masterGTable: GammaTblPtr;
  144.             theGDevice: GDHandle;
  145.  
  146.     begin
  147.         if (gammaUtilsInstalled = kGammaUtilsSig) then
  148.             begin
  149.                 SetupGammaTools := -1;
  150.                 exit(SetupGammaTools);
  151.             end;
  152.         gammaTables := nil;
  153.         gammaUtilsInstalled := kGammaUtilsSig;
  154.         theGDevice := GetDeviceList;
  155.         while (theGDevice <> nil) do
  156.             begin
  157.                 errorCold := GetDevGammaTable(theGDevice, masterGTable);
  158.                 if (errorCold <> 0) then
  159.                     begin
  160.                         SetupGammaTools := errorCold;
  161.                         exit(SetupGammaTools);
  162.                     end;
  163.                 tempHdl := globalGammasHdl(NewHandle(sizeof(globalGammas)));
  164.                 if (tempHdl = nil) then
  165.                     begin
  166.                         SetupGammaTools := MemError;
  167.                         exit(SetupGammaTools);
  168.                     end;
  169.                 with masterGTable^ do
  170.                     begin
  171.                         tempHdl^^.size := sizeof(GammaTbl) + gFormulaSize + (gChanCnt * gDataCnt * gDataWidth div 8);
  172.                         tempHdl^^.dataOffset := gFormulaSize;
  173.                         tempHdl^^.theGDevice := theGDevice;
  174.                     end;
  175.                 tempHdl^^.saved := GammaTblHandle(NewHandle(tempHdl^^.size));
  176.                 if (tempHdl^^.saved = nil) then
  177.                     begin
  178.                         SetupGammaTools := MemError;
  179.                         exit(SetupGammaTools);
  180.                     end;
  181.                 tempHdl^^.hacked := GammaTblHandle(NewHandle(tempHdl^^.size));
  182.                 if (tempHdl^^.hacked = nil) then
  183.                     begin
  184.                         SetupGammaTools := MemError;
  185.                         exit(SetupGammaTools);
  186.                     end;
  187.                 BlockMove(Ptr(masterGTable), Ptr(tempHdl^^.saved^), tempHdl^^.size);
  188.                 tempHdl^^.next := gammaTables;
  189.                 gammaTables := tempHdl;
  190.                 theGDevice := GetNextDevice(theGDevice)
  191.             end;
  192.         SetupGammaTools := 0;
  193.     end;
  194.  
  195.     function DoGammaFade (percent: Integer): OSErr;
  196.  
  197.         var
  198.             errorCold: Integer;
  199.             thesize, i, theNum: LongInt;
  200.             tempHdl: globalGammasHdl;
  201.             gdp: gammaDataPtr;
  202.             tempLong: Longint;
  203.  
  204.     begin
  205.         if (gammaUtilsInstalled <> kGammaUtilsSig) then
  206.             begin
  207.                 DoGammaFade := -1;
  208.                 exit(DoGammaFade);
  209.             end;
  210.         tempHdl := gammaTables;
  211.         while (tempHdl <> nil) do
  212.             begin
  213.                 with tempHdl^^ do
  214.                     begin
  215.                         BlockMove(Ptr(saved^), Ptr(hacked^), size);
  216.                         tempLong := ord(@hacked^^.gFormulaData) + dataOffset;
  217.                         gdp := gammaDataPtr(ord(@hacked^^.gFormulaData) + dataOffset);
  218.                         thesize := hacked^^.gChanCnt * hacked^^.gDataCnt;
  219.                     end;
  220.                 for i := 0 to thesize - 1 do
  221.                     begin
  222.                         theNum := gdp^[i];
  223.                         theNum := (theNum * percent) div 100;
  224.                         gdp^[i] := theNum;
  225.                     end;
  226.                 errorCold := SetDevGammaTable(tempHdl^^.theGDevice, tempHdl^^.hacked^);
  227.                 if (errorCold <> 0) then
  228.                     begin
  229.                         DoGammaFade := errorCold;
  230.                         exit(DoGammaFade);
  231.                     end;
  232.                 tempHdl := tempHdl^^.next;
  233.             end;
  234.         DoGammaFade := 0;
  235.     end;
  236.  
  237.     function DoOneGammaFade (theGDevice: GDHandle; percent: Integer): OSErr;
  238.  
  239.         var
  240.             errorCold: Integer;
  241.             thesize, i, theNum: LongInt;
  242.             tempHdl: globalGammasHdl;
  243.             gdp: gammaDataPtr;
  244.  
  245.     begin
  246.         if (gammaUtilsInstalled <> kGammaUtilsSig) then
  247.             DoOneGammaFade := -1;
  248.         tempHdl := gammaTables;
  249.         while ((tempHdl <> nil) and (theGDevice <> tempHdl^^.theGDevice)) do
  250.             tempHdl := tempHdl^^.next;
  251.         with tempHdl^^ do
  252.             begin
  253.                 BlockMove(Ptr(saved^), Ptr(hacked^), size);
  254.                 gdp := gammaDataPtr(ord(@hacked^^.gFormulaData) + dataOffset);
  255.                 thesize := hacked^^.gChanCnt * hacked^^.gDataCnt;
  256.             end;
  257.         for i := 0 to thesize - 1 do
  258.             begin
  259.                 theNum := gdp^[i];
  260.                 theNum := (theNum * percent) div 100;
  261.                 gdp^[i] := theNum;
  262.             end;
  263.         errorCold := SetDevGammaTable(tempHdl^^.theGDevice, tempHdl^^.hacked^);
  264.         DoOneGammaFade := errorCold;
  265.     end;
  266.  
  267.     function DisposeGammaTools: OSErr;
  268.  
  269.         var
  270.             tempHdl, nextHdl: globalGammasHdl;
  271.  
  272.     begin
  273.         if (gammaUtilsInstalled <> kGammaUtilsSig) then
  274.             begin
  275.                 DisposeGammaTools := -1;
  276.                 exit(DisposeGammaTools);
  277.             end;
  278.         tempHdl := gammaTables;
  279.         while (tempHdl <> nil) do
  280.             begin
  281.                 HLock(Handle(tempHdl));
  282.                 with tempHdl^^ do
  283.                     begin
  284.                         nextHdl := next;
  285.                         DisposeHandle(Handle(saved));
  286.                         DisposeHandle(Handle(hacked));
  287.                         HUnlock(Handle(tempHdl));
  288.                         DisposeHandle(Handle(tempHdl));
  289.                         tempHdl := nextHdl;
  290.                     end;
  291.             end;
  292.         gammaUtilsInstalled := '    ';
  293.         DisposeGammaTools := 0;
  294.     end;
  295.  
  296.     function GetDevGammaTable (theGDevice: GDHandle; var theTable: GammaTblPtr): OSErr;
  297.  
  298.         var
  299.             errorCold: Integer;
  300.             myCPB: ParmBlkPtr;
  301.  
  302.     begin
  303.         theTable := nil;
  304.         if not IsOneGammaAvailable(theGDevice) then
  305.             begin
  306.                 GetDevGammaTable := -1;
  307.                 exit(GetDevGammaTable);
  308.             end;
  309.         myCPB := ParmBlkPtr(NewPtrClear(sizeof(ParamBlockRec)));
  310.         if (myCPB = nil) then
  311.             begin
  312.                 GetDevGammaTable := MemError;
  313.                 exit(GetDevGammaTable);
  314.             end;
  315.         myCPB^.csCode := cscGetGamma;
  316.         myCPB^.ioCRefNum := theGDevice^^.gdRefNum;
  317.         myCPB^.csParam[0] := HiWord(longint(@theTable));
  318.         myCPB^.csParam[1] := LoWord(longint(@theTable));
  319.         errorCold := PBStatusSync(myCPB);
  320.         DisposePtr(Ptr(myCPB));
  321.         GetDevGammaTable := errorCold;
  322.     end;
  323.  
  324.     function SetDevGammaTable (theGDevice: GDHandle; var theTable: GammaTblPtr): OSErr;
  325.  
  326.         var
  327.             myCPB: ParmBlkPtr;
  328.             errorCold: Integer;
  329.             cTab: CTabHandle;
  330.             saveGDevice: GDHandle;
  331.  
  332.     begin
  333.         if not IsOneGammaAvailable(theGDevice) then
  334.             begin
  335.                 SetDevGammaTable := -1;
  336.                 exit(SetDevGammaTable);
  337.             end;
  338.         myCPB := ParmBlkPtr(NewPtrClear(sizeof(ParamBlockRec)));
  339.         if (myCPB = nil) then
  340.             begin
  341.                 SetDevGammaTable := MemError;
  342.                 exit(SetDevGammaTable);
  343.             end;
  344.         myCPB^.csCode := cscSetGamma;
  345.         myCPB^.ioCRefNum := theGDevice^^.gdRefNum;
  346.         myCPB^.csParam[0] := HiWord(longint(@theTable));
  347.         myCPB^.csParam[1] := LoWord(longint(@theTable));
  348.         errorCold := PBControlSync(myCPB);
  349.         if (errorCold = 0) then
  350.             begin
  351.                 saveGDevice := GetGDevice;
  352.                 SetGDevice(theGDevice);
  353.                 cTab := theGDevice^^.gdPMap^^.pmTable;
  354.                 SetEntries(0, cTab^^.ctSize, cTab^^.ctTable);
  355.                 SetGDevice(saveGDevice);
  356.             end;
  357.         DisposePtr(Ptr(myCPB));
  358.         SetDevGammaTable := errorCold;
  359.     end;
  360.  
  361. end.